home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 9 / CDACTUAL9.iso / share / Dos / VARIOS / pascal / SWAG9605.DDD / 0042_Handling Massive Number functions.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-05-31  |  10.3 KB  |  568 lines
  1. {
  2. You may use the following unit I have made for an encryption program
  3. of mine. It implements real binary arithmetic, no BCD. But be careful,
  4. there is currently no range checking at all, and overflows may result
  5. in endless loops. If you need 2048 bit integers you have to set
  6. BigNumLength to at least 128, a little more would be safer. Also
  7. notice that the routines cannot handle negative numbers.
  8.  
  9. I hope you find this one useful.
  10.  
  11.         Jes R Klinke
  12. }
  13.  
  14.  
  15. PROGRAM BigNum;
  16.  
  17. USES
  18.  
  19.   Crt, Dos;
  20.  
  21. CONST
  22.  
  23.   BigNumLength = 20; {Number of words in value}
  24.  
  25. TYPE
  26.  
  27.   PBigNum = ^TBigNum;
  28.   TBigNum = object
  29.  
  30.     Value : ARRAY [0..BigNumLength - 1] OF WORD;
  31.  
  32.     PROCEDURE ASSIGN (VAR AValue : TBigNum);
  33.     PROCEDURE AssignLong (AValue : LONGINT);
  34.     PROCEDURE ADD (VAR AValue : TBigNum);
  35.     PROCEDURE Subtract (VAR AValue : TBigNum);
  36.     PROCEDURE Multiply (VAR AMultiplicator : TBigNum);
  37.     FUNCTION Divide (VAR ADivisor : TBigNum) : BOOLEAN;
  38.     FUNCTION Modulus (VAR ADivisor : TBigNum) : BOOLEAN;
  39.     PROCEDURE SquareRoot;
  40.     PROCEDURE Increment (By : WORD);
  41.     PROCEDURE Decrement (By : WORD);
  42.     PROCEDURE BitwiseOr (VAR AMaske : TBigNum);
  43.     FUNCTION Compare (VAR AValue : TBigNum) : INTEGER;
  44.     PROCEDURE Mult10;
  45.     PROCEDURE Div10;
  46.     PROCEDURE Mult2;
  47.     PROCEDURE Div2;
  48.     FUNCTION STR : STRING;
  49.     FUNCTION Str16 : STRING;
  50.     PROCEDURE VAL (CONST S : STRING);
  51.     FUNCTION AsLong : LONGINT;
  52.   END;
  53.  
  54.  
  55.  
  56. PROCEDURE TBigNum.ASSIGN (VAR AValue : TBigNum);
  57. BEGIN
  58.   MOVE (AValue.Value, Value, SIZEOF (Value) );;
  59. END;
  60.  
  61. PROCEDURE TBigNum.AssignLong (AValue : LONGINT);
  62. BEGIN
  63.   MOVE (AValue, Value [0], SIZEOF (LONGINT) );;
  64.   FILLCHAR (Value [SIZEOF (LONGINT) SHR 1], BigNumLength SHL 1 -
  65. SIZEOF (LONGINT), 0);
  66. END;
  67.  
  68. PROCEDURE TBigNum.ADD (VAR AValue : TBigNum); assembler;
  69. asm
  70.  
  71.     PUSH  DS
  72.     LES    DI, Self
  73.     ADD    DI, OFFSET TBigNum.Value
  74.     LDS    SI, AValue
  75.     ADD    SI, OFFSET TBigNum.Value
  76.     MOV    CX, BigNumLength
  77.     CLD
  78.     CLC
  79. @@0 : LODSW
  80.     ADC    [ES : DI], AX
  81.     INC    DI
  82.     INC    DI
  83.     LOOP  @@0
  84.     POP    DS
  85. END;
  86.  
  87. PROCEDURE TBigNum.Subtract (VAR AValue : TBigNum); assembler;
  88.  
  89. asm
  90.  
  91.     PUSH  DS
  92.     LES    DI, Self
  93.     ADD    DI, OFFSET TBigNum.Value
  94.     LDS    SI, AValue
  95.     ADD    SI, OFFSET TBigNum.Value
  96.     MOV    CX, BigNumLength
  97.     CLD
  98.     CLC
  99. @@0 : LODSW
  100.     SBB    [ES : DI], AX
  101.     INC    DI
  102.     INC    DI
  103.     LOOP  @@0
  104.     POP    DS
  105. END;
  106.  
  107. PROCEDURE TBigNum.Multiply (VAR AMultiplicator : TBigNum); assembler;
  108.  
  109. VAR
  110.  
  111.   Res : ARRAY [0..BigNumLength] OF WORD;
  112. asm
  113.  
  114.     PUSH  DS
  115.     PUSH  BP
  116.     STD
  117.     LES    DI, AMultiplicator
  118.     ADD    DI, OFFSET TBigNum.Value
  119.     LDS    SI, Self
  120.     ADD    SI, OFFSET TBigNum.Value
  121.     PUSH  SI
  122.     LEA    BP, Res
  123.     XOR    SI, SI
  124.     MOV    CX, BigNumLength
  125.     XOR    AX, AX
  126. @@8 : MOV    SS : [BP + SI], AX
  127.     ADD    SI, 2
  128.     LOOP  @@8
  129.     POP    SI
  130.     XOR    BX, BX
  131. @@0 : MOV    CX, BX
  132.     MOV    DX, CX
  133.     SHL    DX, 1
  134.     ADD    SI, DX
  135.     INC    CX
  136. @@1 : LODSW
  137.     MOV    DX, ES : [DI]
  138.     ADD    DI, 2
  139.     MUL    DX
  140.     ADD    SS : [BP], AX
  141.     ADC    SS : [BP + 2], DX
  142.     JC    @@3
  143. @@2 : LOOP  @@1
  144.     MOV    DX, BX
  145.     INC    DX
  146.     SHL    DX, 1
  147.     SUB    DI, DX
  148.     ADD    SI, 2
  149.     ADD    BP, 2
  150.     INC    BX
  151.     CMP    BX, BigNumLength
  152.     JNE    @@0
  153.     CLD
  154.     POP    BP
  155.     LEA    SI, Res
  156.     PUSH  SS
  157.     POP    DS
  158.     LES    DI, Self
  159.     ADD    DI, OFFSET TBigNum.Value
  160.     MOV    CX, BigNumLength
  161.     REP    MOVSW
  162.     POP    DS
  163.     JMP    @@9
  164. @@3 : PUSH  SI
  165.     MOV    DX, 1
  166.     MOV    SI, 4
  167. @@4 : ADD    [BP + SI], DX
  168.     INC   SI
  169.     INC    SI
  170.     JC    @@4
  171.     POP    SI
  172.     JMP    @@2
  173. @@9 :
  174. END;
  175.  
  176. FUNCTION TBigNum.Divide (VAR ADivisor : TBigNum) : BOOLEAN;
  177.  
  178. VAR
  179.   Bit, Res, Divisor : TBigNum;
  180.   WholeResult : BOOLEAN;
  181. BEGIN
  182.  
  183.   Divisor.ASSIGN (ADivisor);
  184.   WholeResult := FALSE;
  185.   Bit.AssignLong (1);
  186.   Res.AssignLong (0);
  187.   WHILE Compare (Divisor) >= 0 DO
  188.   BEGIN
  189.     Bit.Mult2;
  190.     Divisor.Mult2;
  191.   END;
  192.   WHILE (Bit.Value [0] AND 1 = 0) AND NOT WholeResult DO
  193.   BEGIN
  194.     Bit.Div2;
  195.     Divisor.Div2;
  196.     CASE Compare (Divisor) OF
  197.       1 :
  198.       BEGIN
  199.         Res.BitwiseOr (Bit);
  200.         Subtract (Divisor);
  201.       END;
  202.  
  203.       0 :
  204.       BEGIN
  205.         WholeResult := TRUE;
  206.         Res.BitwiseOr (Bit);
  207.         Subtract (Divisor);
  208.       END;
  209.     END;
  210.  
  211.   END;
  212.  
  213.   ASSIGN (Res);
  214.   Divide := WholeResult;
  215.  
  216. END;
  217.  
  218. FUNCTION TBigNum.Modulus (VAR ADivisor : TBigNum) : BOOLEAN;
  219.  
  220. VAR
  221.  
  222.   Bit, Res, Divisor : TBigNum;
  223.   WholeResult : BOOLEAN;
  224.  
  225. BEGIN
  226.  
  227.   Divisor.ASSIGN (ADivisor);
  228.   WholeResult := FALSE;
  229.   Bit.AssignLong (1);
  230.   Res.AssignLong (0);
  231.  
  232.   WHILE Compare (Divisor) >= 0 DO
  233.   BEGIN
  234.  
  235.     Bit.Mult2;
  236.     Divisor.Mult2;
  237.  
  238.   END;
  239.  
  240.   WHILE (Bit.Value [0] AND 1 = 0) AND NOT WholeResult DO
  241.   BEGIN
  242.     Bit.Div2;
  243.     Divisor.Div2;
  244.  
  245.     CASE Compare (Divisor) OF
  246.       1 :
  247.       BEGIN
  248.         Res.BitwiseOr (Bit);
  249.         Subtract (Divisor);
  250.       END;
  251.  
  252.       0 :
  253.       BEGIN
  254.         WholeResult := TRUE;
  255.         Res.BitwiseOr (Bit);
  256.         Subtract (Divisor);
  257.       END;
  258.  
  259.     END;
  260.  
  261.   END;
  262.  
  263.   Modulus := WholeResult;
  264.  
  265. END;
  266.  
  267. PROCEDURE TBigNum.SquareRoot;
  268.  
  269. VAR
  270.  
  271.   Guess, NewGuess : TBigNum;
  272.  
  273. BEGIN
  274.  
  275.   NewGuess.ASSIGN (Self);
  276.   NewGuess.Div2;
  277.  
  278.   REPEAT
  279.  
  280.     Guess.ASSIGN (NewGuess);
  281.     NewGuess.ASSIGN (Self);
  282.     NewGuess.Divide (Guess);
  283.     NewGuess.ADD (Guess);
  284.     NewGuess.Div2;
  285.  
  286.   UNTIL NewGuess.Compare (Guess) = 0;
  287.  
  288.   ASSIGN (NewGuess);
  289.  
  290. END;
  291.  
  292. PROCEDURE TBigNum.Increment (By : WORD); assembler;
  293.  
  294. asm
  295.  
  296.     LES    DI, Self
  297.     ADD    DI, OFFSET TBigNum.Value
  298.     CLD
  299.     MOV    AX, ES : [DI]
  300.     ADD    AX, By
  301.     STOSW
  302.     MOV    CX, BigNumLength - 1
  303. @@0 : MOV    AX, ES : [DI]
  304.     ADC    AX, 0
  305.     STOSW
  306.     LOOP  @@0
  307. END;
  308.  
  309.  
  310. PROCEDURE TBigNum.Decrement (By : WORD); assembler;
  311.  
  312. asm
  313.  
  314.     LES    DI, Self
  315.     ADD    DI, OFFSET TBigNum.Value
  316.     CLD
  317.     MOV    AX, ES : [DI]
  318.     SUB    AX, By
  319.     STOSW
  320.     MOV    CX, BigNumLength - 1
  321. @@0 : MOV    AX, ES : [DI]
  322.     SBB    AX, 0
  323.     STOSW
  324.     LOOP  @@0
  325. END;
  326.  
  327. PROCEDURE TBigNum.BitwiseOr (VAR AMaske : TBigNum); assembler;
  328.  
  329. asm
  330.  
  331.     PUSH  DS
  332.     LES    DI, Self
  333.     ADD    DI, OFFSET TBigNum.Value
  334.     LDS    SI, AMaske
  335.     ADD    SI, OFFSET TBigNum.Value
  336.     MOV    CX, BigNumLength
  337.     CLD
  338. @@0 : LODSW
  339.     OR    AX, ES : [DI]
  340.     STOSW
  341.     LOOP  @@0
  342.     POP    DS
  343. END;
  344.  
  345. FUNCTION TBigNum.Compare (VAR AValue : TBigNum) : INTEGER; assembler;
  346.  
  347. asm
  348.     PUSH  DS
  349.     LES    DI, Self
  350.     ADD    DI, OFFSET TBigNum.Value
  351.     LDS    SI, AValue
  352.     ADD    SI, OFFSET TBigNum.Value
  353.     MOV    CX, BigNumLength
  354.     MOV    DX, CX
  355.     DEC    DX
  356.     SHL    DX, 1
  357.     ADD    DI, DX
  358.     ADD    SI, DX
  359.     STD
  360.     REPZ  CMPSW
  361.     MOV    AX, 0FFFFh
  362.     JA    @@1
  363.     MOV    AX, 0000h
  364.     JE    @@1
  365.     MOV    AX, 0001h
  366. @@1 : POP    DS
  367. END;
  368.  
  369. PROCEDURE TBigNum.Mult10; assembler;
  370.  
  371. asm
  372.  
  373.     LES    DI, Self
  374.     ADD    DI, OFFSET TBigNum.Value
  375.     XOR    BX, BX
  376.     MOV    CX, BigNumLength
  377. @@0 : MOV    AX, [ES : DI]
  378.     MOV    DX, 10
  379.     MUL    DX
  380.     ADD    AX, BX
  381.     ADC    DX, 0
  382.     MOV    [ES : DI], AX
  383.     INC    DI
  384.     INC    DI
  385.     MOV    BX, DX
  386.     LOOP  @@0
  387. END;
  388.  
  389. PROCEDURE TBigNum.Div10; assembler;
  390.  
  391. asm
  392.     LES    DI, Self
  393.     ADD    DI, OFFSET TBigNum.Value
  394.     MOV    CX, BigNumLength
  395.     MOV    DX, CX
  396.     DEC    DX
  397.     SHL    DX, 1
  398.     ADD    DI, DX
  399.     XOR    DX, DX
  400. @@0 : MOV    AX, [ES : DI]
  401.     MOV    BX, 10
  402.     DIV    BX
  403.     MOV    [ES : DI], AX
  404.     DEC    DI
  405.     DEC    DI
  406.     LOOP  @@0
  407. END;
  408.  
  409. PROCEDURE TBigNum.Mult2; assembler;
  410.  
  411. asm
  412.     LES    DI, Self
  413.     ADD    DI, OFFSET TBigNum.Value
  414.     XOR    BX, BX
  415.     MOV    CX, BigNumLength
  416.     CLC
  417.     CLD
  418. @@0 : MOV    AX, [ES : DI]
  419.     RCL    AX, 1
  420.     STOSW
  421.     LOOP  @@0
  422. END;
  423.  
  424. PROCEDURE TBigNum.Div2; assembler;
  425.  
  426. asm
  427.     LES    DI, Self
  428.     ADD    DI, OFFSET TBigNum.Value
  429.     MOV    CX, BigNumLength
  430.     MOV    DX, CX
  431.     DEC    DX
  432.     SHL    DX, 1
  433.     ADD    DI, DX
  434.     XOR    DX, DX
  435.     CLC
  436.     STD
  437. @@0 : MOV    AX, [ES : DI]
  438.     RCR    AX, 1
  439.     STOSW
  440.     LOOP  @@0
  441. END;
  442.  
  443. FUNCTION TBigNum.STR : STRING;
  444.  
  445. VAR
  446.  
  447.   M, T : TBigNum;
  448.   Res : STRING;
  449.   I, Ciffer : INTEGER;
  450.  
  451. BEGIN
  452.  
  453.   M.ASSIGN (Self);
  454.   T.AssignLong (1);
  455.   I := 0;
  456.   WHILE M.Compare (T) >= 0 DO
  457.   BEGIN
  458.     T.Mult10;
  459.     INC (I);
  460.   END;
  461.   IF I <= 1 THEN
  462.   BEGIN
  463.     STR := CHAR (BYTE ('0') + M.Value [0]);
  464.   END
  465.   ELSE
  466.   BEGIN
  467.     Res := '';
  468.     T.Div10;
  469.     WHILE I > 0 DO
  470.     BEGIN
  471.       Ciffer := 0;
  472.       WHILE (M.Compare (T) >= 0) DO
  473.       BEGIN
  474.         M.Subtract (T);
  475.         INC (Ciffer);
  476.       END;
  477.       Res := Res + CHAR (BYTE ('0') + Ciffer);
  478.       DEC (I);
  479.       T.Div10;
  480.     END;
  481.     STR := Res;
  482.   END;
  483. END;
  484.  
  485. FUNCTION TBigNum.Str16 : STRING;
  486.  
  487. CONST
  488.   HexCif : ARRAY [0..15] OF CHAR = '0123456789ABCDEF';
  489. VAR
  490.   Res : STRING;
  491.   I : INTEGER;
  492.   ErMed : BOOLEAN;
  493. BEGIN
  494.   ErMed := FALSE;
  495.   Res := '';
  496.   FOR I := BigNumLength - 1 DOWNTO 0 DO
  497.   BEGIN
  498.     IF ErMed OR (Value [I] <> 0) THEN
  499.     BEGIN
  500.       IF ErMed OR (Value [I] SHR 12 AND $F <> 0) THEN
  501.       BEGIN
  502.         Res := Res + HexCif [Value [I] SHR 12 AND $F];
  503.         ErMed := TRUE;
  504.       END;
  505.       IF ErMed OR (Value [I] SHR 8 AND $F <> 0) THEN
  506.       BEGIN
  507.         Res := Res + HexCif [Value [I] SHR 8 AND $F];
  508.         ErMed := TRUE;
  509.       END;
  510.       IF ErMed OR (Value [I] SHR 4 AND $F <> 0) THEN
  511.       BEGIN
  512.         Res := Res + HexCif [Value [I] SHR 4 AND $F];
  513.         ErMed := TRUE;
  514.       END;
  515.       Res := Res + HexCif [Value [I] AND $F];
  516.       ErMed := TRUE;
  517.     END;
  518.   END;
  519.   Str16 := Res;
  520. END;
  521.  
  522. PROCEDURE TBigNum.VAL (CONST S : STRING);
  523. VAR
  524.   I : INTEGER;
  525. BEGIN
  526.   AssignLong (0);
  527.   I := 1;
  528.   WHILE I <= LENGTH (S) DO
  529.   BEGIN
  530.     Mult10;
  531.     Increment (BYTE (S [I]) - BYTE ('0') );
  532.     INC (I);
  533.   END;
  534. END;
  535.  
  536. FUNCTION TBigNum.AsLong : LONGINT;
  537. VAR
  538.  Res : ^LONGINT;
  539.  
  540. BEGIN
  541.   Res := @Value [0];
  542.   AsLong := Res^;
  543. END;
  544.  
  545. VAR
  546.   ABigNum : TBigNum;
  547.   I : INTEGER;
  548.  
  549.  
  550. BEGIN
  551.   ABigNum.AssignLong (1);
  552.   FOR I := 1 TO 260 DO
  553.   BEGIN
  554.     WRITELN (ABigNum.STR : 79);
  555.     ABigNum.Mult2;
  556.   END;
  557.   FOR I := 1 TO 260 DO
  558.   BEGIN
  559.     WRITELN (ABigNum.STR : 79);
  560.     ABigNum.Div2;
  561.   END;
  562.   WRITELN (ABigNum.STR : 79);
  563.   WRITE ('Press enter to exit.');
  564.   READLN;
  565. END.
  566.  
  567.  
  568.